home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / minilogo / langage.ml < prev    next >
Encoding:
Text File  |  1995-06-01  |  3.1 KB  |  55 lines  |  [TEXT/MPS ]
  1. aleur_expr env e2)
  2.   | Quotient (e1, e2) ->
  3.      divise_nombres (valeur_expr env e1, valeur_expr env e2)
  4.   | Variable s -> assoc s env;;
  5.  
  6. let procédures_définies = ref ([] : (string * procédure) list);;
  7. let définit_procédure (nom, proc as liaison) =
  8.     procédures_définies := liaison :: !procédures_définies
  9. and définition_de nom_de_procédure =
  10.     try
  11.       assoc nom_de_procédure !procédures_définies
  12.     with Not_found ->
  13.       failwith ("procédure inconnue: " ^ nom_de_procédure);;
  14. let valeur_entière = function
  15.     Entier i -> i
  16.   | Flottant f -> failwith "entier attendu";;
  17. exception Fin_de_procédure;;
  18. let rec exécute_ordre env = function
  19.     Av e -> avance (flottant (valeur_expr env e))
  20.   | Re e -> avance (-. (flottant (valeur_expr env e)))
  21.   | Tg a -> tourne (flottant (valeur_expr env a))
  22.   | Td a -> tourne (-. (flottant (valeur_expr env a)))
  23.   | Lc -> fixe_crayon true
  24.   | Bc -> fixe_crayon false
  25.   | Ve -> vide_écran()
  26.   | Rep (n, l) ->
  27.      for i = 1 to valeur_entière (valeur_expr env n)
  28.      do do_list (exécute_ordre env) l done
  29.   | Si (e1, e2, alors, sinon) ->
  30.      if compare_nombres (valeur_expr env e1, valeur_expr env e2)
  31.      then do_list (exécute_ordre env) alors
  32.      else do_list (exécute_ordre env) sinon
  33.   | Stop -> raise Fin_de_procédure
  34.   | Exécute (nom_de_procédure, args) ->
  35.      let définition = définition_de nom_de_procédure in
  36.      let variables = définition.Paramètres
  37.      and corps = définition.Corps in
  38.      let rec augmente_env = function
  39.          [],[] -> env
  40.        | variable::vars, expr::exprs ->
  41.           (variable, valeur_expr env expr) ::
  42.           augmente_env (vars, exprs)
  43.        | _ ->
  44.           failwith ("mauvais nombre d'arguments pour "
  45.                     ^ nom_de_procédure) in
  46.      let env_pour_corps = augmente_env (variables, args) in
  47.      try  do_list (exécute_ordre env_pour_corps) corps
  48.      with Fin_de_procédure -> ();;
  49.  
  50. let rec exécute_phrase = function
  51.     Ordre ord -> exécute_ordre [] ord
  52.   | Pour (nom, proc as liaison) -> définit_procédure liaison
  53. and exécute_programme = function
  54.     Programme phs -> do_list exécute_phrase phs;;
  55.